home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / src_d2.zoo / source / syntax.c < prev    next >
C/C++ Source or Header  |  1991-12-02  |  30KB  |  1,132 lines
  1. /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
  2.    Copyright (C) 1985, 1987, 1990 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22. #include <ctype.h>
  23. #include "lisp.h"
  24. #include "commands.h"
  25. #include "buffer.h"
  26. #include "syntax.h"
  27.  
  28. Lisp_Object Qsyntax_table_p;
  29.  
  30. DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
  31.   "Return t if ARG is a syntax table.\n\
  32. Any vector of 256 elements will do.")
  33.   (obj)
  34.      Lisp_Object obj;
  35. {
  36.   if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400)
  37.     return Qt;
  38.   return Qnil;
  39. }
  40.  
  41. Lisp_Object
  42. check_syntax_table (obj)
  43.      Lisp_Object obj;
  44. {
  45.   register Lisp_Object tem;
  46.   while (tem = Fsyntax_table_p (obj),
  47.      NULL (tem))
  48.     obj = wrong_type_argument (Qsyntax_table_p, obj, 0);
  49.   return obj;
  50. }   
  51.  
  52.  
  53. DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
  54.   "Return the current syntax table.\n\
  55. This is the one specified by the current buffer.")
  56.   ()
  57. {
  58.   return current_buffer->syntax_table;
  59. }
  60.  
  61. DEFUN ("standard-syntax-table", Fstandard_syntax_table,
  62.    Sstandard_syntax_table, 0, 0, 0,
  63.   "Return the standard syntax table.\n\
  64. This is the one used for new buffers.")
  65.   ()
  66. {
  67.   return Vstandard_syntax_table;
  68. }
  69.  
  70. DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
  71.   "Construct a new syntax table and return it.\n\
  72. It is a copy of the TABLE, which defaults to the standard syntax table.")
  73.   (table)
  74.      Lisp_Object table;
  75. {
  76.   Lisp_Object size, val;
  77.   XFASTINT (size) = 0400;
  78.   XFASTINT (val) = 0;
  79.   val = Fmake_vector (size, val);
  80.   if (!NULL (table))
  81.     table = check_syntax_table (table);
  82.   else if (NULL (Vstandard_syntax_table))
  83.     /* Can only be null during initialization */
  84.     return val;
  85.   else table = Vstandard_syntax_table;
  86.  
  87.   bcopy (XVECTOR (table)->contents,
  88.      XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object));
  89.   return val;
  90. }
  91.  
  92. DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
  93.   "Select a new syntax table for the current buffer.\n\
  94. One argument, a syntax table.")
  95.   (table)
  96.      Lisp_Object table;
  97. {
  98.   table = check_syntax_table (table);
  99.   current_buffer->syntax_table = table;
  100.   /* Indicate that this buffer now has a specified syntax table.  */
  101.   current_buffer->local_var_flags |= buffer_local_flags.syntax_table;
  102.   return table;
  103. }
  104.  
  105. /* Convert a letter which signifies a syntax code
  106.  into the code it signifies.
  107.  This is used by modify-syntax-entry, and other things. */
  108.  
  109. char syntax_spec_code[0400] =
  110.   { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  111.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  112.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  113.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  114.     (char) Swhitespace, 0377, (char) Sstring, 0377,
  115.         (char) Smath, 0377, 0377, (char) Squote,
  116.     (char) Sopen, (char) Sclose, 0377, 0377,
  117.     0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
  118.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  119.     0377, 0377, 0377, 0377,
  120.     (char) Scomment, 0377, (char) Sendcomment, 0377,
  121.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* @, A, ... */
  122.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  123.     0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
  124.     0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
  125.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,   /* `, a, ... */
  126.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
  127.     0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
  128.     0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
  129.   };
  130.  
  131. /* Indexed by syntax code, give the letter that describes it. */
  132.  
  133. char syntax_code_spec[13] =
  134.   {
  135.     ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
  136.   };
  137.  
  138. DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
  139.   "Return the syntax code of CHAR, described by a character.\n\
  140. For example, if CHAR is a word constituent, ?w is returned.\n\
  141. The characters that correspond to various syntax codes\n\
  142. are listed in the documentation of  modify-syntax-entry.")
  143.   (ch)
  144.      Lisp_Object ch;
  145. {
  146.   CHECK_NUMBER (ch, 0);
  147.   return make_number (syntax_code_spec[(int) SYNTAX (0xFF & XINT (ch))]);
  148. }
  149.  
  150. /* This comment supplies the doc string for modify-syntax-entry,
  151.    for make-docfile to see.  We cannot put this in the real DEFUN
  152.    due to limits in the Unix cpp.
  153.  
  154. DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0,
  155.   "Set syntax for character CHAR according to string S.\n\
  156. The syntax is changed only for table TABLE, which defaults to\n\
  157.  the current buffer's syntax table.\n\
  158. The first character of S should be one of the following:\n\
  159.   Space    whitespace syntax.    w   word constituent.\n\
  160.   _        symbol constituent.   .   punctuation.\n\
  161.   (        open-parenthesis.     )   close-parenthesis.\n\
  162.   \"        string quote.         \\   character-quote.\n\
  163.   $        paired delimiter.     '   expression prefix operator.\n\
  164.   <       comment starter.     >   comment ender.\n\
  165. Only single-character comment start and end sequences are represented thus.\n\
  166. Two-character sequences are represented as described below.\n\
  167. The second character of S is the matching parenthesis,\n\
  168.  used only if the first character is ( or ).\n\
  169. Any additional characters are flags.\n\
  170. Defined flags are the characters 1, 2, 3 and 4.\n\
  171.  1 means C is the start of a two-char comment start sequence.\n\
  172.  2 means C is the second character of such a sequence.\n\
  173.  3 means C is the start of a two-char comment end sequence.\n\
  174.  4 means C is the second character of such a sequence.")
  175.  
  176. */
  177.  
  178. DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, 
  179.   /* I really don't know why this is interactive
  180.      help-form should at least be made useful whilst reading the second arg
  181.    */
  182.   "cSet syntax for character: \nsSet syntax for %s to: ",
  183.   0 /* See immediately above */)
  184.   (c, newentry, syntax_table)
  185.      Lisp_Object c, newentry, syntax_table;
  186. {
  187.   register unsigned char *p, match;
  188.   register enum syntaxcode code;
  189.   Lisp_Object val;
  190.  
  191.   CHECK_NUMBER (c, 0);
  192.   CHECK_STRING (newentry, 1);
  193.   if (NULL (syntax_table))
  194.     syntax_table = current_buffer->syntax_table;
  195.   else
  196.     syntax_table = check_syntax_table (syntax_table);
  197.  
  198.   p = XSTRING (newentry)->data;
  199.   code = (enum syntaxcode) syntax_spec_code[*p++];
  200.   if (((int) code & 0377) == 0377)
  201.     error ("invalid syntax description letter: %c", c);
  202.  
  203.   match = *p;
  204.   if (match) p++;
  205.   if (match == ' ') match = 0;
  206.  
  207.   XFASTINT (val) = (match << 8) + (int) code;
  208.   while (*p)
  209.     switch (*p++)
  210.       {
  211.       case '1':
  212.     XFASTINT (val) |= 1 << 16;
  213.     break;
  214.  
  215.       case '2':
  216.     XFASTINT (val) |= 1 << 17;
  217.     break;
  218.  
  219.       case '3':
  220.     XFASTINT (val) |= 1 << 18;
  221.     break;
  222.  
  223.       case '4':
  224.     XFASTINT (val) |= 1 << 19;
  225.     break;
  226.       }
  227.     
  228.   XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val;
  229.  
  230.   return Qnil;
  231. }
  232.  
  233. /* Dump syntax table to buffer in human-readable format */
  234.  
  235. describe_syntax (value)
  236.     Lisp_Object value;
  237. {
  238.   register enum syntaxcode code;
  239.   char desc, match, start1, start2, end1, end2;
  240.   char str[2];
  241.  
  242.   Findent_to (make_number (16), make_number (1));
  243.  
  244.   if (XTYPE (value) != Lisp_Int)
  245.     {
  246.       InsStr ("invalid");
  247.       return;
  248.     }
  249.  
  250.   code = (enum syntaxcode) (XINT (value) & 0377);
  251.   match = (XINT (value) >> 8) & 0377;
  252.   start1 = (XINT (value) >> 16) & 1;
  253.   start2 = (XINT (value) >> 17) & 1;
  254.   end1 = (XINT (value) >> 18) & 1;
  255.   end2 = (XINT (value) >> 19) & 1;
  256.  
  257.   if ((int) code < 0 || (int) code >= (int) Smax)
  258.     {
  259.       InsStr ("invalid");
  260.       return;
  261.     }
  262.   desc = syntax_code_spec[(int) code];
  263.  
  264.   str[0] =